home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / HYP / E-G / Fractal3.cpt / fractal3.a < prev    next >
Text File  |  1989-02-26  |  13KB  |  506 lines
  1. ;
  2. ;    fractal xcmd v0.3 -- Doug Felt, Oct 14, 1987
  3. ;    
  4. ;    This draws a fractal on the screen.  Not to the card, yet.  Function is
  5. ;    f(z) = z * z + c, julia set mapped to 4 patterns.
  6. ;    
  7. ;    Format:
  8. ;         Fractal seed.h seed.v [res = 8 [limit = 32 [lock = 0]]]
  9. ;         
  10. ;    seed is the complex constant c (v imaginary)
  11. ;    res is the number of pixels on a side for the point to plot 
  12. ;    limit is the max number of iterations (best between 16 & 128, multiple of 4),
  13. ;    lower limit means most complex regions of the fractal are white
  14. ;    if lock is 0, pressing the mouse will immediately stop the drawing, otherwise
  15. ;    pressing the mouse has no effect and drawing can only be stopped by reboot or
  16. ;    fancy macsbug work.
  17. ;   
  18. ;    Doug Felt, AIR/CAT Project
  19. ;    duggie@jessica.stanford.edu
  20. ;
  21. ;    
  22. ;    To compile and link in MPW C:
  23. ;
  24. ;    C -q2 Fractal.c
  25. ;    link -sn Main=Fractal -sn STDIO=Fractal ∂
  26. ;         -sn INTENV=Fractal -rt XCMD=104 ∂
  27. ;         -m FRACTAL Fractal.c.o "{CLibraries}CRunTime.o" ∂
  28. ;         -o HyperCommands
  29. ;
  30. ;
  31. ;
  32. ;    Fractal3 xcmd v3.0 -- Ray Sanders, Nov 7, 1987
  33. ;
  34. ;        Well now, I thought this was so neat, and Doug was right it needs a 
  35. ;    little more speed. So thats what I did, I rewrote the "C" program in 
  36. ;    assembler with direct processing on the MC68881 FPU. I think this makes
  37. ;    quite a difference. The only thing is that it only runs on a MacII. It
  38. ;    might run on one or more of the accelerator cards. Give it a try. If 
  39. ;    necessary, change the COID= parameter below if they are using other than 1.
  40. ;
  41. ;                    Ray Sanders
  42. ;                Green Grass Software, Inc.
  43. ;
  44. ;            CIS: 70277,3233     GEnie: RAYSANDERS
  45. ;
  46. ;    To assemble and link with MPW:
  47. ;
  48. ;                fractal3.a.o ƒ fractal3.make fractal3.a
  49. ;                    Asm fractal3.a -l -font Monaco,9
  50. ;                fractal3 ƒ fractal3.make fractal3.a.o
  51. ;                    link -o fractal3 -rt XCMD=106 -sn Main=Fractal3 -t STAK -c WILD ∂
  52. ;                        fractal3.a.o ∂
  53. ;                        -o "Fractals"
  54. ;
  55. ;
  56. fractal2    MAIN
  57.         
  58.         BLANKS        ON
  59.         STRING        ASIS
  60.         MC68881        COID=1,PREC=X,ROUND=N
  61. ;         INCLUDE        'Traps.a'
  62. ;         INCLUDE        'SysEqu.a'
  63. ;         INCLUDE        'QuickEqu.a'
  64.         PRINT        OFF
  65.          INCLUDE        'Traps.a'
  66.          INCLUDE        'SysEqu.a'
  67.          INCLUDE        'QuickEqu.a'
  68.         PRINT        ON,NOWARN
  69. ;        PRINT        ON
  70.  
  71.  
  72. ; HyperCard data structure offsets
  73.  
  74. XCmdParamCount    EQU        0                ;number of parameters
  75. XCmdParams        EQU        2                ;16 handles to C-strings
  76. XCmdReturnVal    EQU        66                ;handle to return string
  77. XCmdPassFlag    EQU        70                ;boolean, to pass message through
  78. XCmdEntryPoint    EQU        72                ;hyperCard call-back
  79. XCmdRequest        EQU        76                ;call back opcode field
  80. XCmdResult        EQU        78                ;call back result field
  81. XCmdInArgs        EQU        80                ;8 longs, input arguments
  82. XCmdOutArgs        EQU        112                ;4 longs, output arguments
  83.  
  84. MenuList        EQU        $A1C
  85.  
  86. ;    result codes
  87.  
  88. xresSucc             EQU        0
  89. xresFail             EQU        1 
  90. xresNotImp             EQU        2 
  91.  
  92. ;    request codes
  93.  
  94. xreqSendCardMessage        EQU        1 
  95. xreqEvalExpr            EQU        2 
  96. xreqStringLength        EQU        3 
  97. xreqStringMatch            EQU        4 
  98. xreqSendHCMessage        EQU        5
  99. xreqZeroBytes             EQU        6 
  100. xreqPasToZero            EQU        7 
  101. xreqZeroToPas            EQU        8 
  102. xreqStrToLong            EQU        9 
  103. xreqStrToNum            EQU        10 
  104. xreqStrToBool            EQU        11 
  105. xreqStrToExt            EQU        12 
  106. xreqLongToStr            EQU        13 
  107. xreqNumToStr            EQU        14 
  108. xreqNumToHex            EQU        15 
  109. xreqBoolToStr            EQU        16 
  110. xreqExtToStr            EQU        17 
  111. xreqGetGlobal            EQU        18 
  112. xreqSetGlobal            EQU        19 
  113. xreqGetFieldByName        EQU        20 
  114. xreqGetFieldByNum        EQU        21 
  115. xreqGetFieldByID        EQU        22 
  116. xreqSetFieldByName        EQU        23 
  117. xreqSetFieldByNum        EQU        24 
  118. xreqSetFieldByID        EQU        25 
  119. xreqStringEqual           EQU        26 
  120. xreqReturnToPas           EQU        27 
  121. xreqScanToReturn          EQU        28 
  122. xreqScanToZero            EQU        39   ;    was suppose to be 29!  Oops!
  123.  
  124.  
  125. ; definition of stack frame
  126.  
  127. stackStor    RECORD    0,DECREMENT
  128. stackStorStart    EQU        *
  129. xcmdBlockAddr    DS.L    1
  130. noLock            DS.W    1
  131. res                DS.W    1
  132. hsize            DS.W    1
  133. vsize            DS.W    1
  134. i                DS.W    1
  135. j                DS.W    1
  136. iter            DS.W    1
  137. limit            DS.W    1
  138. rbaseh            DS.W    1
  139. rat                DS.L    3
  140. seedh            DS.L    3
  141. seedv            DS.L    3
  142. valh            DS.L    3
  143. valv            DS.L    3
  144. temp            DS.L    3
  145. basev            DS.L    3
  146. baseh            DS.L    3
  147. hsq                DS.L    3
  148. vsq                DS.L    3
  149. real2            DS.L    3
  150. realn2            DS.L    3
  151. real100            DS.L    3
  152. fake256            DS.L    1
  153. fake171            DS.L    1
  154. fake2            DS.L    1
  155. fake100            DS.L    1
  156. r                DS.W    4
  157. tempX            DS.L    3
  158. tempBig            DS.B    256
  159. tempL            DS.L    1
  160. srcBM            DS.W    7
  161. dstR            DS.W    4
  162. CurPort            DS.L    1
  163. stackStorLen    EQU     *-stackStorStart 
  164.             ENDR
  165.  
  166.             WITH stackStor
  167. EntryPoint
  168. ;;;        _Debugger                            ;
  169.         LINK    A6,#stackStorLen            ;
  170.         MOVEM.L    A0-A6/D0-D7,-(SP)            ;
  171.     
  172.         MOVE.L    8(A6),A3                    ;
  173.         MOVE.L    A3,xcmdBlockAddr(A6)        ;
  174.         
  175.         CMPI.W    #3,XCmdParamCount(A3)        ; if (paramPtr->paramCount<2) return
  176.         BLT        FracsDone                    ;
  177.         
  178.         MOVE.W    #8,res(A6)                    ; res = 8
  179.         
  180.         MOVE.W    #32,limit(A6)                ; limit = 32
  181.         
  182.         MOVE.W    #1,nolock(A6)                ; nolock = 1
  183.  
  184.         MOVE.L    XCmdParams(A3),-(SP)        ; seedh = ParamToExt(paramPtr,0)
  185.         PEA.L    seedh(A6)                    ;
  186.         BSR        ZeroToExt                    ;
  187.         ADDQ.L    #8,SP                        ;
  188.         
  189.         MOVE.L    XCmdParams+4(A3),-(SP)        ; seedv = ParamToExt(paramPtr,1)
  190.         PEA.L    seedv(A6)                    ;
  191.         BSR        ZeroToExt                    ;
  192.         ADDQ.L    #8,SP                        ;
  193.  
  194.         CMPI.W    #3,XCmdParamCount(A3)        ; if (paramPtr->paramCount>2)
  195.         BLT        @150                        ;
  196.         MOVE.L    XCmdParams+8(A3),-(SP)        ; res = ParamToNum(paramPtr,2)
  197.         PEA.L    tempL(A6)                    ;
  198.         BSR        ZeroToNum                    ;
  199.         ADDQ.L    #8,SP                        ;
  200.         MOVE.W    tempL+2(A6),res(A6)            ;
  201.         
  202.         MOVE.W    #1,res(A6)                    ; FORCE   res = 1
  203.  
  204.         CMPI.W    #4,XCmdParamCount(A3)        ; if (paramPtr->paramCount>3)
  205.         BLT        @150                        ;
  206.         MOVE.L    XCmdParams+12(A3),-(SP)        ; limit = ParamToNum(paramPtr,3)
  207.         PEA.L    tempL(A6)                    ;
  208.         BSR        ZeroToNum                    ;
  209.         ADDQ.L    #8,SP                        ;
  210.         MOVE.W    tempL+2(A6),limit(A6)        ;
  211.         
  212.         CMPI.W    #3,limit(A6)                ; if (limit<4) 
  213.         BGT.S    @120                        ;
  214.         MOVE.W    #4,limit(A6)                ;     limit = 4
  215. @120
  216.  
  217.         CMPI.W    #5,XCmdParamCount(A3)        ; if (paramPtr->paramCount>4)
  218.         BLT        @150                        ;
  219.         MOVE.L    XCmdParams+16(A3),-(SP)        ; nolock = !ParamToNum(paramPtr,4)
  220.         PEA.L    tempL(A6)                    ;
  221.         BSR        ZeroToNum                    ;
  222.         ADDQ.L    #8,SP                        ;
  223.         MOVE.W    tempL+2(A6),nolock(A6)        ;
  224.         NOT.W    nolock(A6)                    ;
  225. @150
  226.  
  227. ;    /* map screen onto -2 to 2 range */
  228. ;    
  229. ;    /* 0,0 is at 512/2, 342/2 = 256,171 */
  230. ;    
  231. ;    /* gridding to res requires that I find out how many boxes wide and tall
  232. ;       the image is, and map each box onto a value in r2.  then i iterate over
  233. ;       all the boxes calling the function until the x or y exceeds some limit.
  234. ;       then i map the number of iterations into a 'color' */
  235. ;       
  236. ;    /* since we don't have a global data area for extended constants to live in,
  237. ;       use longs and fake the compiler into making the correct SANE calls to 
  238. ;       build the extended values.  Is there a better way (besides using Pascal!) */
  239. ;
  240.         MOVE.L    #256,fake256(A6)            ; fake256 = 256
  241.         
  242.         MOVE.L    #171,fake171(A6)            ; fake171 = 171
  243.         
  244.         MOVE.L    #2,fake2(A6)                ; fake2 = 2
  245.         
  246.         MOVE.L    #100,fake100(A6)            ; fake100 = 100
  247.  
  248.         MOVE.L    #256,D0                        ; hsize = (fake256/res)+1
  249.         DIVS.W    res(A6),D0                    ;
  250.         ADDQ.W    #1,D0                        ;
  251.         MOVE.W    D0,hsize(A6)                ;
  252.         
  253.         MOVE.L    #171,D0                        ; vsize = (fake171/res)+1
  254.         DIVS.W    res(A6),D0                    ;
  255.         ADDQ.W    #1,D0                        ;
  256.         MOVE.W    D0,vsize(A6)                ;
  257.         
  258.         FMOVECR.X #$34,FP0                    ; real100 = fake100
  259.         FMOVE.X    FP0,real100(A6)                ;
  260.         
  261.         FMOVE.W    #2,FP0                        ; real2 = fake2
  262.         FMOVE.X    FP0,real2(A6)                ;
  263.         
  264.         FMOVE.W    #-2,FP0                        ; realn2 = -fake2
  265.         FMOVE.X    FP0,realn2(A6)                ;
  266.         
  267.         FMOVE.X    real2(A6),FP0                ; rat = real2/hsize
  268.         FDIV.W    hsize(A6),FP0                ;
  269.         FMOVE.X    FP0,rat(A6)                    ; /* reals intermediate result because of real2 */
  270.         
  271.         MOVE.W    res(A6),D0                    ; rbaseh = 256-hsize*res
  272.         MULS.W    hsize(A6),D0                ;
  273.         MOVE.W    #256,D1                        ;
  274.         SUB.W    D0,D1                        ;
  275.         MOVE.W    D1,rbaseh(A6)                ;
  276.         
  277.         MOVE.W    res(A6),D0                    ; r.top = 171-vsize*res
  278.         MULS.W    vsize(A6),D0                ;
  279.         MOVE.W    #171,D1                        ;
  280.         SUB.W    D0,D1                        ;
  281.         MOVE.W    D1,r(A6)                    ;
  282.         
  283.         ADD.W    res(A6),D1                    ; r.bottom = r.top + res
  284.         MOVE.W    D1,r+4(A6)                    ;
  285.         
  286.         FMOVE.L    fake171(A6),FP2                ; basev = realn2*fake171/fake256
  287.         FMUL.X    realn2(A6),FP2                ; /* center it */
  288.         FDIV.L    fake256(A6),FP2                ;
  289.         
  290.         FMOVE.X    seedv(A6),FP0                ;
  291.         FMOVE.X    seedh(A6),FP1                ;
  292.  
  293. ;            for loop
  294.         
  295.         MOVE.W    vsize(A6),D4                ; for (i=-vsize; i<vsize; ++i)
  296.         NEG.W    D4                            ;
  297. @200
  298.         CMP.W    vsize(A6),D4                ;
  299.         BGE        @500                        ;
  300.         
  301.         MOVE.W    rbaseh(A6),D0                ; r.left = rbaseh
  302.         MOVE.W    D0,r+2(A6)                    ;
  303.         
  304.         ADD.W    res(A6),D0                    ; r.right = r.left + res
  305.         MOVE.W    D0,r+6(A6)                    ;
  306.         
  307.         FMOVE.X    realn2(A6),FP3                ; baseh = realn2
  308.         
  309. ;            for loop
  310.  
  311.         MOVE.W    hsize(A6),D3                ; for (j=-hsize; j<hsize; ++j)
  312.         NEG.W    D3                            ;
  313. @250
  314.         CMP.W    hsize(A6),D3                ;
  315.         BGE        @450                        ;
  316.         
  317.         FMOVE.X    FP3,FP5                        ; valh = baseh
  318.         
  319.         FMOVE.X    FP2,FP4                        ; valv = basev
  320.         
  321.         CLR.W    D5                            ; iter = 0
  322.         
  323. ;            do loop
  324.  
  325. @300
  326. ;
  327. ;
  328. ;    register assignments to speed up loop
  329. ;
  330. ;        hsq is in FP7
  331. ;        vsq is in FP6
  332. ;        valh is in FP5
  333. ;        valv is in FP4
  334. ;        baseh is in FP3
  335. ;        basev is in FP2
  336. ;        seedh is in FP1
  337. ;        seedv is in FP0
  338. ;
  339.         
  340.         FMOVE.X    FP4,FP6                        ; vsq = valv * valv
  341.         FMUL.X    FP4,FP6                        ;
  342.         
  343.         FMUL.X    FP5,FP4                        ; valv = real2*valh*valv + seedv
  344.         FADD.X    FP4,FP4                        ;
  345.         FADD.X    FP0,FP4                        ;
  346.         
  347.         FMUL.X    FP5,FP5                        ; hsq = valh * valh
  348.         FMOVE.X    FP5,FP7                        ;
  349.         
  350.         FSUB.X    FP6,FP5                        ; valh = hsq - vsq + seedh
  351.         FADD.X    FP1,FP5                        ;
  352.         
  353.         ADDQ.W    #1,D5                        ; ++iter
  354.         
  355.         FADD.X    FP6,FP7                        ; while ((hsq+vsq<real100) && (iter<limit))
  356.         FMOVECR.X #$34,FP6                    ;
  357.         FCMP.X    FP7,FP6                        ;
  358.         FBLE.W    @350                        ;
  359.         CMP.W    limit(A6),D5                ;
  360.         BLE        @300                        ;
  361.  
  362. @350
  363.         FADD.X    rat(A6),FP3                    ; baseh += rat
  364.         
  365.         MOVE.W    r+2(A6),D2                    ; get left pixel #
  366.         SUB.W    rbaseh(A6),D2                ; make rel to zero
  367.         ANDI.W    #-32,D2                        ; got long word #
  368.         LSR.W    #3,D2                        ; divide by 8 ( get's displ)
  369.         LEA.L    tempBig(A6),A1                ; get base
  370.         ADDA.W    D2,A1                        ; pt to line
  371.  
  372.         ANDI.W    #3,D5                        ;
  373.         LSL.W    #4,D5                        ;
  374.         MOVE.W    r(A6),D6                    ; get top line #
  375.         ANDI.W    #3,D6                        ; take mod 4
  376.         LSL.W    #2,D6                        ; mult by 4
  377.         ADD.W    D6,D5                        ; displ to pattern
  378.         LEA.L    pats,A0                        ;
  379.         ADDA.W    D5,A0                        ;
  380.  
  381.         MOVE.W    r+2(A6),D0                    ; get left pixel #
  382.         SUB.W    rbaseh(A6),D0                ; make rel to zero
  383.         MOVEQ.L    #31,D2                        ;
  384.         AND.W    D2,D0                        ; take mod 32
  385.         BNE.S    @447                        ; no
  386.         CLR.L    (A1)                        ; clear the word
  387. @447
  388.         SUB.W    D0,D2                        ;
  389.         CLR.L    D0                            ;
  390.         BSET.L    D2,D0                        ; set the bit
  391.  
  392.         AND.L    (A0),D0                        ; get bits
  393.         OR.L    D0,(A1)                        ; set bit
  394.  
  395.         MOVE.W    res(A6),D0                    ; r.left += res
  396.         ADD.W    D0,r+2(A6)                    ;
  397.         
  398.         ADD.W    D0,r+6(A6)                    ; r.right += res
  399.         
  400.         ADDQ.W    #1,D3                        ;
  401.         BRA        @250                        ;
  402.  
  403. @450
  404.  
  405.         PEA.L    CurPort(A6)                    ;
  406.         _GetPort                            ;
  407.  
  408.         FADD.X    rat(A6),FP2                    ; basev += rat
  409.  
  410.         LEA.L    tempBig(A6),A0                ; pt to bit area
  411.         MOVE.L    A0,srcBM(A6)                ; set it
  412.         MOVE.W    #64,srcBM+4(A6)                ; set rowBytes
  413.  
  414.         MOVE.W    #0,dstR+2(A6)                ; set left
  415.         MOVE.W    #512,dstR+6(A6)                ; set right
  416.         MOVE.W    r(A6),D0                    ; get top
  417.         MOVE.W    D0,dstR(A6)                    ; set top
  418.         ADD.W    #1,D0                        ;
  419.         MOVE.W    D0,dstR+4(A6)                ; set bottom
  420.  
  421.         MOVE.L    dstR(A6),srcBM+6(A6)        ;
  422.         MOVE.L    dstR+4(A6),srcBM+10(A6)        ;
  423.  
  424.         PEA.L    srcBM(A6)                    ;
  425.         MOVE.L    CurPort(A6),A0                ; get ptr to port
  426.         PEA.L    portBits(A0)                ; dest bitmap
  427.         PEA.L    dstR(A6)                    ;
  428.         PEA.L    dstR(A6)                    ;
  429.         MOVE.W    #srcCopy,-(SP)                ;
  430.         CLR.L    -(SP)                        ;
  431.         _CopyBits
  432.  
  433.         MOVE.W    res(A6),D0                    ; r.top += res
  434.         ADD.W    D0,r(A6)                    ;
  435.         
  436.         ADD.W    D0,r+4(A6)                    ; r.bottom += res
  437.         
  438.         TST.W    nolock(A6)                    ; if (nolock && Button()) return
  439.         BEQ.S    @475                        ;
  440.         CLR.W    -(SP)                        ;
  441.         _Button                                ;
  442.         TST.W    (SP)+                        ;
  443.         BNE        FracsDone                    ;
  444. @475
  445.         
  446.         ADDQ.W    #1,D4                        ;
  447.         BRA        @200                        ;
  448.  
  449. @500
  450. FracsDone
  451.         MOVEM.L    (SP)+,A0-A6/D0-D7        ; restore registers
  452.         UNLK    A6
  453.         MOVE.L    (SP)+,(SP)
  454.         RTS
  455.  
  456. ZeroToNum
  457.         MOVE.L    xcmdBlockAddr(A6),A3    ; xcmd blk ptr
  458.         MOVE.L    8(SP),A0                ; handle to num string
  459.         MOVE.L    (A0),XCmdInArgs(A3)        ; ptr to num string
  460.         LEA.L    tempBig(A6),A0            ; pt to temp string area
  461.         MOVE.L    A0,XCmdInArgs+4(A3)        ; set temp string ptr
  462.         MOVE.W    #xreqZeroToPas,XCmdRequest(A3) ; convert to pascal string
  463.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  464.         JSR        (A0)                    ; call HC
  465.         LEA.L    tempBig(A6),A0            ; pt to temp string area
  466.         MOVE.L    A0,XCmdInArgs(A3)        ; set first arg
  467.         MOVE.W    #xreqStrToNum,XCmdRequest(A3) ; set req code
  468.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  469.         JSR        (A0)                    ; call HC
  470.         MOVE.L    4(SP),A0                ; ptr to result field
  471.         MOVE.L    XCmdOutArgs(A3),(A0)    ; set result
  472.         RTS                                ;
  473.  
  474. ZeroToExt
  475.         MOVE.L    xcmdBlockAddr(A6),A3    ; xcmd blk ptr
  476.         MOVE.L    8(SP),A0                ; handle to num string
  477.         MOVE.L    (A0),XCmdInArgs(A3)        ; ptr to num string
  478.         LEA.L    tempBig(A6),A0            ; pt to temp string area
  479.         MOVE.L    A0,XCmdInArgs+4(A3)        ; set temp string ptr
  480.         MOVE.W    #xreqZeroToPas,XCmdRequest(A3) ; convert to pascal string
  481.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  482.         JSR        (A0)                    ; call HC
  483.         LEA.L    tempBig(A6),A0            ; pt to temp string area
  484.         MOVE.L    A0,XCmdInArgs(A3)        ; set first arg
  485.         LEA.L    tempX(A6),A0            ; pt to temp string area
  486.         MOVE.L    A0,XCmdInArgs+4(A3)        ; set first arg
  487.         MOVE.W    #xreqStrToExt,XCmdRequest(A3) ; set req code
  488.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  489.         JSR        (A0)                    ; call HC
  490.         MOVE.L    4(SP),A0                ; ptr to result field
  491.         MOVE.W    tempX(A6),(A0)+            ; set result
  492.         CLR.W    (A0)+                    ; fill in the zeros
  493.         MOVE.L    tempX+2(A6),(A0)+        ; set result
  494.         MOVE.L    tempX+6(A6),(A0)+        ; set result
  495.         RTS                                ;
  496.  
  497. pats
  498.         DC.L    $00000000,$00000000,$00000000,$00000000
  499.         DC.L    $AAAAAAAA,$00000000,$55555555,$00000000
  500.         DC.L    $55555555,$FFFFFFFF,$AAAAAAAA,$FFFFFFFF
  501.         DC.L    $FFFFFFFF,$FFFFFFFF,$FFFFFFFF,$FFFFFFFF
  502.             ENDWITH
  503.             ENDMAIN
  504.             END
  505.  
  506.